home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / COM / World Wide Web Weaver.sit / World Wide Web Weaver / World Wide Web Weaver 1.1.1 д / Extras / MacWebLint 1.011 / MacWebLint-lib.pl < prev    next >
Text File  |  1995-12-06  |  8KB  |  264 lines
  1. #========================================================================
  2. # Function:    whine
  3. # Purpose:    Give a standard format whine:
  4. #            filename(line #): <message>
  5. #               The associative array `enabled' is used as a gating
  6. #               function, to suppress or enable each warning.  Every
  7. #               warning has an associated identifier, which is used to
  8. #               refer to the warning, and as the index into the hash.
  9. #========================================================================
  10. sub whine
  11. {
  12.    local($line, $id, @argv) = @_;
  13.    local($mstyle)        = $variable{'message-style'};
  14.  
  15. ## JS 12-6-95
  16. ## Added the following lines so that the results would be saved to a file
  17. ## this is nice for the mac version.
  18.    local ($outFile) = ":MacWebLint Results";
  19.     open (OUTFILE, ">>$outFile") || die "cannot do it: $!¥n";
  20.     
  21.    return unless $enabled{$id};
  22.    $exit_status = 1;
  23.  
  24. ## JS 12-6-95
  25. ## rewritten to output to a text file cause this is the way that
  26. ## i want it to work. this is the best way that i know how to do it.
  27.  
  28.   if ($mstyle eq 'terse') {
  29.       print "$filename:$line:$id¥n";
  30.       print OUTFILE "$filename:$line:$id¥n";
  31.    return; }
  32.    
  33.   if ($mstyle eq 'lint') {
  34.       (eval "print ¥"$filename($line): $message{$id}¥n¥"");
  35.       (eval "print OUTFILE ¥"$filename($line): $message{$id}¥n¥"");
  36.   return; }
  37.  
  38.   if ($mstyle eq 'short') {
  39.       (eval "print ¥"line $line: $message{$id}¥n¥"");
  40.       (eval "print OUTFILE ¥"line $line: $message{$id}¥n¥"");
  41.    return; }
  42.       
  43.    close (OUTFILE);
  44.  
  45. # JS 12-6-95
  46. #  commented this out because it is re-done above
  47. #   (print "$filename:$line:$id¥n"), return             if $mstyle eq 'terse';
  48. #   (eval "print ¥"$filename($line): $message{$id}¥n¥""), return if $mstyle eq 'lint';
  49. #   (eval "print ¥"line $line: $message{$id}¥n¥""), return if $mstyle eq 'short';
  50.  
  51.    die "Unknown message style `$mstyle'¥n";
  52. }
  53.  
  54. #========================================================================
  55. # Function:    GetConfigFile
  56. # Purpose:    Read user's configuration file, if such exists.
  57. #               If WEBLINTRC is set in user's environment, then read the
  58. #               file referenced, otherwise try for $HOME/.weblintrc.
  59. #========================================================================
  60. sub GetConfigFile
  61. {
  62.    local(*CONFIG);
  63.    local($filename);
  64.    local($arglist);
  65.    local($value);
  66.  
  67. # JS 12-6-96
  68. # this is the config file for MacWebLint.
  69.    $filename = "MacWebLint.rc";
  70.    return unless -f $filename;
  71.  
  72.    open(CONFIG,"< $filename") || do
  73.    {
  74.       print WARNING "Unable to read config file `$filename': $!¥n";
  75.       return 0;
  76.    };
  77.  
  78.    while (<CONFIG>)
  79.    {
  80.       s/#.*$//;
  81.       next if /^¥s*$/o;
  82.  
  83.       #-- match keyword: process one or more argument -------------------
  84.       if (/^¥s*(enable|disable|extension|ignore)¥s+(.*)$/io)
  85.       {
  86.      $keyword = "¥U$1";
  87.      $arglist = $2;
  88.      while ($arglist =~ /^¥s*(¥S+)/o)
  89.      {
  90.         $value = "¥L$1";
  91.  
  92.         &enableWarning($1, 1) if $keyword eq 'ENABLE';
  93.  
  94.         &enableWarning($1, 0) if $keyword eq 'DISABLE';
  95.  
  96.         $ignore{"¥U$1"} = 1 if $keyword eq 'IGNORE';
  97.  
  98.         &AddExtension($1) if $keyword eq 'EXTENSION';
  99.  
  100.         $arglist = $';
  101.      }
  102.       }
  103.       elsif (/^¥s*set¥s+(¥S+)¥s*=¥s*(.*)/)
  104.       {
  105.          # setting a weblint variable
  106.          if (defined $variable{$1})
  107.          {
  108.             $variable{$1} = $2;
  109.          }
  110.          else
  111.          {
  112.             print WARNING "Unknown variable `$1' in configuration file¥n"
  113.          }
  114.       }
  115.    }
  116.  
  117.    close CONFIG;
  118.  
  119.    1;
  120. }
  121.  
  122. sub enableWarning
  123. {
  124.    local($id, $enabled) = @_;
  125.  
  126.  
  127.    if (! defined $enabled{$id})
  128.    {
  129.       print WARNING "$PROGRAM: unknown warning identifier ¥"$id¥"¥n";
  130.       return 0;
  131.    }
  132.  
  133.    $enabled{$id} = $enabled;
  134.  
  135.    #
  136.    # ensure consistency: if you just enabled upper-case,
  137.    # then we should make sure that lower-case is disabled
  138.    #
  139.    $enabled{'lower-case'} = 0 if $_ eq 'upper-case';
  140.    $enabled{'upper-case'} = 0 if $_ eq 'lower-case';
  141.    $enabled{'upper-case'} = $enabled{'lower-case'} = 0 if $_ eq 'mixed-case';
  142.  
  143.    return 1;
  144. }
  145.  
  146. #========================================================================
  147. # Function:    AddExtension
  148. # Purpose:    Extend the HTML understood.  Currently supported extensions:
  149. #            netscape  - the netscape extensions proposed by
  150. #                                   Netscape Communications, Inc.  See:
  151. #               http://www.netscape.com/home/services_docs/html-extensions.html
  152. #========================================================================
  153. sub AddExtension
  154. {
  155.    local($extension) = @_;
  156.  
  157.    if ("¥L$extension" ne 'netscape')
  158.    {
  159.       warn "$PROGRAM: unknown extension `$extension' -- ignoring.¥n";
  160.       return;
  161.    }
  162.  
  163.    #---------------------------------------------------------------------
  164.    # netscape extensions
  165.    #---------------------------------------------------------------------
  166.  
  167.    #-- new element attributes for existing elements ---------------------
  168.  
  169.    &AddAttributes('ISINDEX',  'PROMPT');
  170.    &AddAttributes('HR',       'SIZE', 'WIDTH', 'ALIGN', 'NOSHADE');
  171.    &AddAttributes('UL',       'TYPE');
  172.    &AddAttributes('OL',       'TYPE', 'START');
  173.    &AddAttributes('LI',       'TYPE', 'VALUE');
  174.    &AddAttributes('IMG',      'BORDER', 'VSPACE', 'HSPACE');
  175.    &AddAttributes('BODY',     'BGCOLOR', 'TEXT', 'LINK', 'VLINK', 'ALINK');
  176.    &AddAttributes('TABLE',    'CELLSPACING', 'CELLPADDING');
  177.    &AddAttributes('TD',       'WIDTH');
  178.    &AddAttributes('TH',       'WIDTH');
  179.  
  180.    #-- new elements -----------------------------------------------------
  181.  
  182.    $legalElements .= '|'.$netscapeElements;
  183.    $pairElements  .= '|BLINK|CENTER|FONT|NOBR';
  184.    &AddAttributes('FONT',     'SIZE');
  185.    &AddAttributes('BASEFONT', 'SIZE');
  186. }
  187.  
  188. sub AddAttributes
  189. {
  190.    local($element,@attributes) = @_;
  191.    local($attr);
  192.  
  193.  
  194.    $attr = join('|', @attributes);
  195.    if (defined $validAttributes{$element})
  196.    {
  197.       $validAttributes{$element} .= "|$attr";
  198.    }
  199.    else
  200.    {
  201.       $validAttributes{$element} = "$attr";
  202.    }
  203. }
  204.  
  205. #========================================================================
  206. # Function:    ListWarnings()
  207. # Purpose:    List all supported warnings, with identifier, and
  208. #        whether the warning is enabled.
  209. #========================================================================
  210. sub ListWarnings
  211. {
  212.    local($id);
  213.    local($message);
  214.  
  215.  
  216.    foreach $id (sort keys %enabled)
  217.    {
  218.       ($message = $message{$id}) =~ s/¥$argv¥[¥d+¥]/.../g;
  219.       $message =~ s/¥¥"/"/g;
  220.       print WARNING "$id (", ($enabled{$id} ? "enabled" : "disabled"), ")¥n";
  221.       print WARNING "    $message¥n¥n";
  222.    }
  223. }
  224.  
  225. sub CheckURL
  226. {
  227.    local($url)        = @_;
  228.    local($workfile)    = "$TMPDIR/$PROGRAM.$$";
  229.    local($urlget)    = $variable{'url-get'};
  230.  
  231.  
  232.    die "$PRORGAM: url-get variable is not defined -- ".
  233.        "don't know how to get $url¥n" unless defined $urlget;
  234.  
  235.    system("$urlget $url > $workfile");
  236.    &WebLint($workfile, $url);
  237.    unlink $workfile;
  238. }
  239.  
  240. #========================================================================
  241. # Function:    wanted
  242. # Purpose:    This is called by &find() to determine whether a file
  243. #               is wanted.  We're looking for files, with the filename
  244. #               extension .html or .htm.
  245. #========================================================================
  246.  
  247. ## JS 12-6-96
  248. ## Changed the "/" to a ":" below
  249.  
  250. sub wanted
  251. {
  252.    if (-d $_ && ! -f "$_$variable{'directory-index'}")
  253.    {
  254.       &whine('*', 'directory-index', "$arg$_", $variable{'directory-index'});
  255.    }
  256.  
  257.    /¥.(html|htm)$/ &&        # valid filename extensions: .html .htm
  258.       -f $_ &&            # only looking for files
  259.       (!$opt_l || !-l $_) &&    # ignore symlinks if -l given
  260.       &WebLint($_,$name);    # check the file
  261. }
  262.  
  263. 1;
  264.